home *** CD-ROM | disk | FTP | other *** search
- unit uTCPService;
- //------------------------------------------------------------------------------
- // Last updated: 11/06/03
- // Author: Dennis Passmore
- // Company: Ultimate Software, Inc.
- // Contact info: dennis_passmore@ultimatesoftware.com
- //
- // Compatibility: Delphi for .NET TCP service demo
- //
- // Description: ServiceInstaller for TmpService application
- //
- //------------------------------------------------------------------------------
- interface
-
- uses
- Borland.VCL.Sysutils,
- System.Configuration,
- System.ServiceProcess,
- System.Collections.Specialized,
- System.Runtime.Remoting,
- System.Runtime.Remoting.Channels,
- System.Runtime.Remoting.Channels.TCP,
- System.Runtime.Serialization.Formatters,
- uTCPIntf;
-
-
- type
- TNTService = class(System.ServiceProcess.ServiceBase)
- strict protected
- procedure OnContinue; override;
- procedure OnPause; override;
- procedure OnShutdown; override;
- procedure OnStart(args: array of string); override;
- procedure OnStop; override;
- public
- constructor Create;
- end;
-
- THelloService = class(MarshalByRefObject, ITCPService)
- function SayHello(const fItem: string; out aResult: string): boolean;
- end;
-
- var
- NTService: TNTService = nil;
- HSobj: THelloService = nil;
-
- implementation
-
- uses
- uTCPServInst;
-
- function THelloService.SayHello(const fItem: string; out aResult: string): boolean;
- begin
- aResult := 'Hello ' + fItem;
- Result := true;
- end;
-
- constructor TNTService.Create;
- begin
- inherited Create;
- ServiceName := cNTServiceProg;
- CanHandlePowerEvent := false;
- CanPauseAndContinue := false;
- CanShutdown := true;
- CanStop := true;
- EventLog.Source := cNTServiceDesc;
- EventLog.Log := 'Application';
- AutoLog := true;
- end;
-
- procedure TNTService.OnContinue;
- begin
- inherited; // should never be called
- //todo
- end;
-
- procedure TNTService.OnPause;
- begin
- inherited; // should never be called
- // todo
- end;
-
- procedure TNTService.OnShutdown;
- begin
- inherited;
- // todo
- end;
-
- procedure TNTService.OnStart(args: array of string);
- var
- chan: TcpChannel;
- Dictionary: ListDictionary;
- provider: System.Runtime.Remoting.Channels.BinaryServerFormatterSinkProvider;
- AppSettings: AppSettingsReader;
- error, iport: integer;
- sport: string;
- oport: TObject;
- begin
- inherited;
- AppSettings := AppSettingsReader.create;
- oport := AppSettings.GetValue('port', typeof(''));
- sport := oport.ToString;
- if sport = '' then
- sport := '8085';
- val(sport,iport,error);
-
- provider := BinaryServerFormatterSinkProvider.create;
- provider.TypeFilterLevel := TypeFilterLevel.Full;
-
- Dictionary := ListDictionary.create;
- Dictionary.Add('port', tobject(iport));
-
- chan := TcpChannel.create(Dictionary, nil, provider);
- ChannelServices.RegisterChannel(chan);
-
- RemotingConfiguration.RegisterWellKnownServiceType(
- typeof(THelloService), 'HelloService',
- WellKnownObjectMode.SingleCall);
- end;
-
- procedure TNTService.OnStop;
- begin
- inherited;
- // todo
- end;
-
- end.
-